Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/Talk 1.0.6/Talk ƒ/Preferences.p

Text File | 1992-04-20 | 7.6 KB | 341 lines | [TEXT/PJMM]

unit Preferences;

{ This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }

interface

    procedure InitPreferences;
    function FinishPreferences: boolean;
    procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);  { used for ODoc/Params }
    procedure OpenPreferences;
    procedure SegmentPrefs;

implementation

    uses
        MyTypes, MyUtils, MyUtilities, MyFileSystem, MyStandardFile, Folders, MySystem7,{}
        BaseGlobals, AppGlobals, OOMainLoop, MyFMenus, PrefsGlobals, MyPreferences, MyDialogs;

    const
        Pref_Save_item = 1;
        Pref_Default_Item = Pref_Save_item;  { Must be one anyway, since we use OutlineDefault1 }
        Pref_Cancel_item = 2;
        User_item = 3;

        ARS_item = 4;
        ARS_count = 3;
        ARS_last = 6;
        ARS_item_talk = 5;
        NAS_item = 7;
        NBS_item = 8;
        NFS_item = 9;
        NSS_item = 10;
        ATS_item = 11;
        CSS_item = 12;
        RIIS_item = 13;
        UNT_item = 14;
        UANS_item = 15;
        TBPS_item = 16;
        NRDS_Item = 17;

    type
        PrefsObject = object(DTObject)
                procedure Create (id: integer);
                override;
                procedure Destroy;
                override;
                procedure DoClose;
                override;
                procedure DoKey (modifiers: integer; ch: char; code: integer);
                override;
                procedure DoItem (item: integer);
                override;
            end;

    var
        noAlert: boolean;
        prefs_fs: FSSpec;
        dialog_prefs: prefsRecord;
        prefs_dialog_dirty: boolean;
        prefs_object: PrefsObject;

    procedure SetDialog (dp: dialogPtr);
    forward;

{$S Prefs}
    procedure SegmentPrefs;
    begin
    end;

{$S}
    procedure SetPrefsMenu (themenu, theitem: integer);
    begin
        SetIDItemEnable(themenu, theitem, not IsWObjectFront(prefs_object));
    end;

{$S Init}
    procedure InitPreferences;
    begin
        noAlert := false;
        prefs_object := nil;
        GetPrefsFSSpec(prefs_fs);
        JustGetPrefs(prefs);
        SetFBoth(Cpreferences, @OpenPreferences, @SetPrefsMenu);
    end;

{$S Prefs}
    procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);
        var
            fs: FSSpec;
            oe: OSErr;
            prefs_rn, a: integer;
    begin
        oe := MyResolveAliasFile(wdrn, dirID, name);
        fs.vRefNum := wdrn;
        fs.parID := dirID;
        fs.name := name;
        prefs_rn := OpenPrefsFile(prefs_fs);
        if prefs_rn <> -1 then begin
            GetPrefs(prefs);
            CloseResFile(prefs_rn);
            if prefs_object <> nil then
                SetDialog(prefs_object.window);
        end
        else if not noAlert then
            a := Alert(pref_read_alert_id, nil);
    end;

{$S Prefs}
    procedure SaveDefaults;
    begin
        JustSetprefs(prefs);
    end;

{$S Term}
    function FinishPreferences: boolean;
    begin
        if prefs_object <> nil then
            prefs_object.DoClose;
        FinishPreferences := prefs_object <> nil;
    end;

{$S Prefs}
    function GetControl (dp: dialogPtr; item: integer): boolean;
        var
            kind: integer;
            r: rect;
            h: controlHandle;
    begin
        GetDItem(dp, item, kind, handle(h), r);
        GetControl := GetCtlValue(h) <> 0;
    end;

{$S Prefs}
    procedure SetControl (dp: dialogPtr; item: integer; on: boolean);
        var
            kind: integer;
            r: rect;
            h: controlHandle;
    begin
        GetDItem(dp, item, kind, handle(h), r);
        SetCtlValue(h, ord(on));
        prefs_dialog_dirty := true;
    end;

{$S Prefs}
    procedure SetControls (dp: dialogPtr; first, count, value: integer);
        var
            i: integer;
    begin
        for i := 0 to count - 1 do
            SetControl(dp, first + i, i = value);
    end;

{$S Prefs}
    function GetControls (dp: dialogPtr; first, count: integer): integer;
        var
            i: integer;
    begin
        GetControls := 0;
        for i := 0 to count - 1 do
            if GetControl(dp, first + i) then
                GetControls := i;
    end;

{$S Prefs}
    procedure SetDialog (dp: dialogPtr);
    begin
        dialog_prefs := prefs;
        with prefs do begin
            SetControls(dp, ARS_item, ARS_count, ord(allowconnect));
            SetControl(dp, NAS_item, notify_alert);
            SetControl(dp, NBS_item, notify_beep);
            SetControl(dp, NFS_item, notify_flash);
            SetControl(dp, NSS_item, show_status);
            SetControl(dp, ATS_item, auto_talk);
            SetControl(dp, CSS_item, close_status);
            SetControl(dp, RIIS_item, reply_if_idle);
            SetItemText(dp, UNT_item, usernames);
            SetControl(dp, UANS_item, answer_to_anyname);
            SetControl(dp, TBPS_item, type_in_bottom_pane);
            SetControl(dp, NRDS_Item, no_return_delete);
        end;
        prefs_dialog_dirty := false;
    end;

{$S Prefs}
    procedure GetDialog (dp: dialogPtr);
    begin
        prefs := dialog_prefs;
        with prefs do begin
            signedByte(allowconnect) := GetControls(dp, ARS_item, ARS_count);
            notify_alert := GetControl(dp, NAS_item);
            notify_beep := GetControl(dp, NBS_item);
            notify_flash := getControl(dp, NFS_item);
            show_status := GetControl(dp, NSS_item);
            auto_talk := GetControl(dp, ATS_item);
            close_status := GetControl(dp, CSS_item);
            reply_if_idle := GetControl(dp, RIIS_item);
            GetItemtext(dp, UNT_item, usernames);
            ValidateUserNames(usernames);
            answer_to_anyname := GetControl(dp, UANS_item);
            type_in_bottom_pane := GetControl(dp, TBPS_item);
            no_return_delete := GetControl(dp, NRDS_Item);
        end;
        prefs_dialog_dirty := false;
    end;

    function DialogDirty (dp: dialogPtr): boolean;
        var
            usernames: str255;
    begin
        GetItemtext(dp, UNT_item, usernames);
        ValidateUserNames(usernames);
        DialogDirty := prefs_dialog_dirty or (usernames <> prefs.usernames);
    end;

{$S}
    procedure OpenPreferences;
    begin
        if prefs_object <> nil then begin
            if FrontWindow <> prefs_object.window then
                SelectWindow(prefs_object.window);
        end
        else begin
            new(prefs_object);
            prefs_object.Create(pref_dialog_id);
        end;
    end;

{$S Prefs}
    procedure PrefsObject.Create (id: integer);
        var
            gv: longInt;
    begin
        SetVersionParamText('', '');
        inherited Create(id);
        ok_item := Pref_Default_Item;
        cancel_item := Pref_Cancel_Item;
        SetUpDefaultOutline(window, Pref_Default_item, User_item);
        if (Gestalt(gestaltOSAttr, gv) <> noErr) | (not BTST(gv, gestaltLaunchControl)) then begin
            if prefs.allowconnect = AC_Talk then
                prefs.allowconnect := AC_Never;
            HiliteItem(window, ARS_item_talk, false);
        end;
        SetDialog(window);
        ShowWindow(window);
    end;

{$S Prefs}
    procedure Toggle (dp: dialogPtr; item: integer);
    begin
        prefs_dialog_dirty := true;
        SetControl(dp, item, not GetControl(dp, item));
    end;

{$S Prefs}
    procedure PrefsObject.DoKey (modifiers: integer; ch: char; code: integer);
    begin
        prefs_dialog_dirty := true;
    end;

{$S Prefs}
    procedure PrefsObject.DoItem (item: integer);
        procedure CheckClick (item: integer);
        begin
            SetControl(window, item, not GetControl(window, item));
        end;
        var
            reply: MySFReply;
            typeList: SFTypeList;
            dfs: boolean;
    begin
        with prefs do begin
            case item of
                ARS_item..ARS_last:  begin
                    SetControls(window, ARS_item, ARS_count, item - ARS_item);
                    prefs_dialog_dirty := true;
                end;
                NAS_item:
                    Toggle(window, NAS_item);
                NBS_item:
                    Toggle(window, NBS_item);
                NFS_item:
                    Toggle(window, NFS_item);
                NSS_item:
                    Toggle(window, NSS_item);
                ATS_item:
                    Toggle(window, ATS_item);
                CSS_item:
                    Toggle(window, CSS_item);
                RIIS_item:
                    Toggle(window, RIIS_item);
                UANS_item:
                    Toggle(window, UANS_item);
                TBPS_item:
                    Toggle(window, TBPS_item);
                NRDS_Item:
                    Toggle(window, NRDS_Item);
                Pref_Save_item:  begin
                    if DialogDirty(window) then begin
                        GetDialog(window);
                        SaveDefaults;
                    end;
                    Destroy;
                end;
                Pref_Cancel_item:
                    Destroy;
                otherwise
                    ;
            end;
        end;
    end;

{$S Prefs}
    procedure PrefsObject.Destroy;
    begin
        inherited Destroy;
        prefs_object := nil;
    end;

{$S Prefs}
    procedure PrefsObject.DoClose;
        var
            dp: dialogPtr;
            sc: SCType;
    begin
        if DialogDirty(window) then begin
            sc := SaveChanges;
        end
        else
            sc := SCDiscard;
        if sc = SCSave then begin
            GetDialog(window);
            SaveDefaults;
        end;
        if sc <> SCCancel then begin
            Destroy;
        end;
    end;

end.